SPACE 2/SPACE - Library 2 - Volume 1.iso/program/167/pascal/fulldir.pas

Pascal/Delphi Source File | 1987-08-19 | 5.0 KB | 172 lines

PROGRAM dir_list ;

(* This Program is written in O.S.S Personal Pascal.  It was written by:
   Christopher Reed over the weekend of 6/27/87.  It was written for two
   reasons:
       1. Provide a tool to list all files on a disk.
       2. Demonstrate the recursive properties of Pascal

  I think recursion is an extreamly important concept.
  I have added comments where special scope considerations for recursion
    are required.
  These same considerations apply to non-recursive techiniques !

  Also, I present here a program format style which I have developed over the
  (all too many) years.
  Of note is the indentation of IF - THEN-ELSE and BEGIN - END
        and REPEAT - WHILE / UNTIL.
  BEGIN and its END, IF and its ELSE (if present) always start at the same
    offset.
  I always have IF and its THEN, WHILE and its DO on the same line.
  BEGIN, END, ELSE and REPEAT are so important that they appear on a line alone
  (The exception to this is the WITH ... BEGIN which appear on the same line.)
  It is important to have control statements formatted consistantly.
  I indent 3 spaces after controling or guarding statements, but only only one
    after data structuring statements.
  I have more style rules but the above are the most important.   *)

CONST
   suffex_len = 5 ;
   suffex_value = '\*.*' ;
   attr_node_bit = $10 ;

TYPE
  name_inx = 0..79 ;
  path_name = PACKED ARRAY [ name_inx ] OF char ;
  fn_range = 0..13 ;
  fname = PACKED ARRAY [ fn_range ] OF char ;
  frec = PACKED RECORD
     reserved : PACKED ARRAY [ 0..19 ] OF byte ;
     resvd2 : byte ;
     attrib : byte ;
     time_stamp : integer ;
     date_stamp : integer ;
     size : long_integer ;
     name : fname ;
   END ;
  title = record
     length : integer ;
     name   : path_name ;
   END ;

VAR
  i : fn_range ;
  path_string : STRING ;
  path : title ;

PROCEDURE set_dta( VAR buf : frec ) ;
   GEMDOS( $1a ) ;

FUNCTION get_first( var path : path_name ; search_attrib :integer ):integer ;
   GEMDOS( $4e ) ;

FUNCTION get_next : integer ;
   GEMDOS( $4f ) ;

PROCEDURE show_file( VAR r : frec ) ;
 var
   i : fn_range ;
BEGIN WITH r DO
 BEGIN
   write ( '     '  ) ;
   i := 0;
   WHILE name[i] <> chr(0) DO
   BEGIN
      write ( name[i] );
      i := i + 1;
   END ;
   writeln ;
 END ;
END ;

FUNCTION get_path (var path : title ) : boolean ;
 var
   path_string : string ;
   i : integer ;
BEGIN
   get_path :=  false;
   write( 'search path: ' ) ;
   readln( path_string ) ;
   IF length ( path_string ) > 0 THEN
      get_path := true ;
   FOR i := 0 TO length( path_string )-1 DO
      path.name[i] := path_string[i+1] ;
   path.length := length ( path_string );
   path.name[ path.length +1 ] := chr(0) ;
END ;

PROCEDURE append ( a : fname ; var b : title ) ;
 var
   i : integer;
BEGIN
   i := 0;
   WITH b DO BEGIN
    name[length] := '\' ;
    length := length + 1 ;
    WHILE a[i] <> chr(0) DO
    BEGIN
       name [ length ] := a[i] ;
       length := length + 1 ;
       i := i + 1 ;
    END ;
    name [ length ] := chr(0) ;
 END ;
END ;

PROCEDURE append_stars ( a : title; var b :path_name ) ;
 var
   suffex : string [ suffex_len ] ;
   i : integer ;
BEGIN
   (* appends '\*.*' to a and returns as b*)
   suffex := suffex_value ;
   b := a.name ;
   for i := 0 to suffex_len -1  DO
      b [ i +a.length ] := suffex[i +1] ;
   b [a.length +suffex_len +1] := chr(0) ;
END ;

FUNCTION Search_Dir ( path : title ) : boolean ;
 var
   path_param : title ;  { to be used for the recursive call }
   file_name  : path_name ;
   r          : frec ;   (* to hold the results of GEM_DOS calls *)
BEGIN
   writeln (' search for : ', path.name );
   set_dta( r ) ;
   Search_Dir := true ; (* assume there is no file *)
   append_stars ( path, file_name ) ;
   IF get_first( file_name, 1 | attr_node_bit  ) = 0 THEN
   BEGIN
      Search_Dir := false ; (* there is a file here *)
      REPEAT
         IF r.attrib & attr_node_bit <> 0 THEN
         BEGIN (* it's a node but might not be real *)
            IF r.name[0] <> '.'  THEN
            BEGIN (* its a real node, prepare to re-search *)
                  { The var Path-param only is needed in this block but
                    Pascal dosen't offer a new var declaration here
                    ( use MODULA2 ) }
               path_param := path ; { create a new var for next level }
               append ( r.name, path_param );
               IF Search_Dir ( path_param ) THEN { RECURSE }
                  Writeln ( '** No Item in this folder **' ) ;
               {***  RE-ESTABLISH THE SYSTEM GLOBALS AT THIS LEVEL ***}
               set_dta( r ) ;
            END ;
         END
         ELSE
            show_file( r ) ; (* or any other file processing *)
      UNTIL get_next < 0 ;
      writeln ( '<' );
   END ;
END ;

BEGIN { DIR.LIST }
   WHILE get_path ( path ) DO
   BEGIN
      IF Search_Dir ( path ) THEN
         writeln( 'no files match specification!' ) ;
   END ;
END.